1000 REM SAVE"0:COMMON CODE.PAL",8
1010 OPEN 8,8,8,"0:COMMON CODE,P,W
1020 [158]700
1030 .OPT O8
1040 ; [172] COMM[145] CODE BY JACK R. FARRAH
1050 ;PROGRAM [164] FIND IDENTICAL CODE SEQUENCES
1060 ;IN MACHINE LANGUAGE PROGRAMS [129] USE
1070 ;AS [185]SIBLE SUBROUTINES.
1080 ;TESTED PROGRAM [164] BE IN MEM[176]Y.
1090 ;ALL USER [133]S IN HEX.
1100 ;SCREEN [176] [153]ER OUTPUT.
1110 ;SPACE BAR PAUSES [155]ING.
1120 ; [172] C[145]S[192]TS [172]
1130 CHRIN [178] $FFCF ;[161] MULT. CHAR.[133]
1140 CHROUT [178] $FFD2 ;[153] [164] DEVICE
1150 [161]IN [178] $FFE4 ;[161] [191]GLE CHAR.
1160 STADD [178] $FB ;START ADDRESS
1170 CKADD [178] $FD ;CHECK ADDRESS
1180 SETLFS [178] $FFBA ;SET [188]. FILE
1190 SETNAM [178] $FFBD ;NAME FILE
1200 [159] [178] $FFC0 ;[159] FILE
1210 [160] [178] $FFC3 ;[160] FILE
1220 CHKOUT [178] $FFC9 ;SET OUTPUT FILE
1230 [156]CHN [178] $FFCC ;[140] [150]AULTS
1240 [172][178]$0801 ;2049
1250 .W[176]D TWOBRK ;[129]WARD PO[181]ER
1260 .BYTE 10,0 ;LINE NUMBER
1270 .BYTE $9E ;"SYS" KEYW[176]D [164]KEN
1280 .[198] "2061" ;[158] ADDRESS
1290 BRK
1300 TWOBRK .W[176]D 0
1310 LDA #147 ;CLEAR SCREEN
1320 JSR CHROUT
1330 BEGIN LDX #0
1340 STX INFLG ;CLEAR FLAGS
1350 STX MTCHFLG
1360 ;[172][161] USER START ADDRESS[172]
1370 TITL LDA TITLE,X ;[153] PROG. NAME
1380 BEQ START ;[175] START ADD.
1390 JSR CHROUT ;[133] MESSAGE
1400 INX
1410 BNE TITL
1420 START LDX #0 ;SET INDEX
1430 JSR CR[145] ;BLINK CURS[176]
1440 JSR [161] ;[161] ADDRESS
1450 CHECK CPX #5 ;">4 CHARACTERS?
1460 BCS ERROR ;ONLY WANT 4
1470 CK1 DEX  ;RESET FOR CR COUNTED
1480 CPX #255 ;ONLY AFTER 4
1490 BEQ CONVERT ;MAKE BINARY
1500 LDA HXADD,X ;GET HEX ASCII
1510 JSR EVAL ;CHECK IF VALID
1520 BCC CK1 ;OK.GET NEXT CHAR.
1530 ;*ERROR MESSAGE LOOP*
1540 ERROR LDA #$0D ;CR
1550 JSR CHROUT
1560 JSR CROF ;TURN OFF CURSOR
1570 LDX #0
1580 ER1 LDA ERMESS,X ;PRINT ERROR MESSAGE
1590 BEQ BEGIN ;START OVER
1600 JSR CHROUT
1610 INX
1620 BNE ER1
1630 ;*CHANGE ASCII HEX TO BINARY & STORE
1640 CONVERT LDX #0 ;SET INDEX
1650 JSR CROF ;UNBLINK CURSOR
1660 LOOP LDA HXADD,X ;GET ASCII
1670 JSR MAKBI ;MAKE BINARY
1680 ASL  ;SHIFT VALUE INTO
1690 ASL  ;HIGH NYBBLE POSITION
1700 ASL
1710 ASL
1720 STA HXADD,X ;SAVE IT
1730 INX  ;RAISE INDEX
1740 LDA HXADD,X ;GET NEXT ASCII
1750 JSR MAKBI ;MAKE BINARY
1760 CPX #3 ;"4TH CHARACTER?
1770 BEQ OVER ;YES. FINISH HERE
1780 CLC  ;NO
1790 ADC HXADD ;ADD [164] HIGH NYBBLE
1800 STA HXADD ;[148] COMBINED [197]UE
1810 INX  ;RAISE INDEX
1820 BNE LOOP ;ALWAYS BRANCH
1830 OVER CLC  ;ADD LOW NYBBLE OF
1840 ADC HXADD[170]2 ;LOW BYTE [164] HIGH
1850 STA HXADD[170]2 ;[175] [148] IT
1860 [128] LDA INFLG ;"DONE END ADDRESS?
1870 BNE OUTPUT ;YES.FLAG SET
1880 LDA HXADD ;NO.SAVE START ADD.
1890 STA STADD+1 ;ON ZERO PAGE
1900 LDA HXADD+2
1910 STA STADD
1920 LDA #$0D ;CR
1930 JSR CHROUT
1940 STA INFLG ;SET FLAG
1950 ;*GET USER END ADDRESS*
1960 LDX #0 ;CLEAR INDEX
1970 END1 LDA ENDMESS,X ;PRINT MESSAGE
1980 BEQ NEXT
1990 JSR CHROUT
2000 INX
2010 BNE END1
2020 NEXT LDX #0 ;CLEAR FOR CHAR. COUNT
2030 JSR CRON ;BLINK CURSOR
2040 JSR GET ;GET THE ADDRESS
2050 JMP CHECK ;CHECK &MAKE BINARY
2060 OUTPUT LDA HXADD ;GET BINARY END ADD.
2070 STA ENCK+1 ;AND STORE IN ZERO PAGE
2080 LDA HXADD+2
2090 STA ENCK
2100 LDA #$0D ;CR
2110 JSR CHROUT
2120 ;*GET OUTPUT DESTINATION FROM USER*
2130 LDX #0
2140 OUT1 LDA OUTMESS,X ;PRINT MESSAGE
2150 BEQ GETIT
2160 JSR CHROUT
2170 INX
2180 BNE OUT1
2190 GETIT JSR GETIN ;GET 'S' OR 'P'
2200 BEQ GETIT ;WAIT FOR KEY
2210 CMP #80 ;"P?
2220 BEQ [153] ;YES. [159] [153]ER
2230 CMP #83 ;"NO. S?
2240 BNE GETIT ;NO.(null) BACK FOR KEY
2250 BEQ BYTE ;SCREEN OUTPUT
2260 PRINT JSR PROUT ;OPEN PRINTER FILE
2270 ;*GET BYTE LGTH. FROM USER*
2280 BYTE LDX #0
2290 BYTLUP LDA BYTMESS,X ;PRINT MESSAGE
2300 BEQ GTBYT
2310 JSR CHROUT
2320 INX
2330 BNE BYTLUP
2340 ERJMP JMP ERROR ;OUT OF RANGE AVOIDER
2350 GTBYT JSR CRON ;BLINK CURSOR
2360 GT2 JSR GETIN ;GET KEY
2370 BEQ GT2 ;WAIT FOR KEY
2380 CMP #$0D ;"CR?
2390 BEQ SET[128] ;[150]AULT SELECTED
2400 JSR CHROUT ;[162] [197]UE. [153] IT
2410 JSR E[197] ;CHECK RANGE
2420 JSR MAKBI ;MAKE BINARY
2430 ASL  ;SH[139]T [164] HI NYBBLE
2440 ASL
2450 ASL
2460 ASL
2470 STA HLDR ;[148] IT
2480 GT1 JSR [161]IN ;[161] SEC[145]D CHAR.
2490 BEQ GT1 ;[146] [129] IT
2500 JSR CHROUT ;[153] IIT
2510 JSR E[197] ;CHECK RANGE
2520 JSR MAKBI ;MAKE BINARY
2530 CLC  ;ADD [164] HI NYBBLE
2540 ADC HLDR
2550 CMP #2 ;">1?
2560 BCC ERJMP ;<2 NOT ALLOWED
2570 STA CKBYT ;STORE NEW VALUE
2580 LDA #$0D ;CR
2590 JSR CHROUT
2600 ;*CALCULATE END ADDRESSES*
2610 SETEND JSR CROF ;UNBLINK CURSOR
2620 LDA #$0D ;CR
2630 JSR CHROUT
2640 LDA CKBYT ;GET LGTH. TO CHECK
2650 SEC
2660 SBC #2 ;SUBTRACT 2
2670 STA HLDR ;TEMPORARY SAVE
2680 LDA ENCK ;LOW BYTE END ADD.
2690 SEC
2700 SBC HLDR ;SUBTRACT VALUE
2710 STA ENCK ;SAVE NEW VALUE
2720 BCC SUBHI ;REDUCE HI BYTE
2730 SET1 LDA ENCK ;GET NEW END ADD.
2740 SEC
2750 SBC CKBYT ;SUBTRACT BYTE LGTH
2760 STA MTCHCK ;SAVE AS CHECK VALUE
2770 BCC SUB2 ;REDUCE HI BYTE
2780 LDA ENCK+1 ;GET HI BYTE NEW END
2790 SET2 STA MTCHCK+1 ;MAKE SAME HERE
2800 SET3 LDA STADD ;START ADD. LOW BYTE
2810 CLC
2820 ADC CKBYT ;ADD BYTE LGTH
2830 STA CKADD ;CHECK POINTER
2840 LDA STADD+1 ;HI BYTE
2850 ADC #0 ;ADD CARRY
2860 STA CKADD+1 ;PUT IN POINTER
2870 JMP MAIN ;START MAIN LOOP
2880 SUBHI DEC ENCK+1
2890 JMP SET1
2900 SUB2 LDA ENCK+1
2910 SBC #1
2920 JMP SET2
2930 ;*MAIN PROGAM LOOP*
2940 MAIN LDY #0 ;CLEAR FOR IND.ADD.MODE
2950 LDA (STADD),Y ;GET VALUE AT START
2960 CMP (CKADD),Y ;NEXT TO CHECK
2970 BEQ (null)TMTCH ;THEY MATCH.CHECK MORE.
2980 MA1 CLC  ;NO MATCH
2990 LDA CKADD ;ADD 1 TO CHECK ADD.
3000 ADC #1
3010 STA CKADD ;STORE BACK
3020 LDA CKADD+1 ;FIX HIGH BYTE
3030 ADC #0
3040 STA CKADD+1 ;STORE
3050 LDA CKADD ;HAVE WE REACHED
3060 CMP ENCK ;"END OF POSSIBLE BYTES?
3070 BNE MAIN ;NO.START [130] SERIES
3080 LDA CKADD[170]1 ;LO BYTES MATCHED
3090 CMP ENCK[170]1 ;"HI BYTES SAME?
3100 BNE MAIN ;NO.CONTINUE
3110 CLC  ;DONE WITH THIS SERIES
3120 LDA STADD ;MOVE START POINTER
3130 ADC #1 ;TO NEXT HIGHEST BYTE
3140 STA STADD ;STORE IT
3150 LDA STADD+1 ;FIX HI BYTE
3160 ADC #0
3170 STA STADD+1
3180 LDX #0 ;CLEAR FLAG TO SHOW PRINT
3190 STX MTCHFLG ;ROUTINE THIS IS NEW ADD.
3200 LDA STADD ;COMPARE START ADD.
3210 CMP MTCHCK ;WITH LAST CHECKABLE BYTE
3220 BNE RETURN ;NO MATCH LOW BYTE
3230 LDA STADD+1 ;CHECK HI BYTE
3240 CMP MTCHCK+1
3250 BNE RETURN ;NO MATCH
3260 JMP EXIT ;ALL DONE, CLOSE UP
3270 RETURN JMP SET3 ;OUT OF RANGE AVOIDER
3280 ;*CHECK REMAINING BYTES FOR MATCH*
3290 (null)TMTCH LDX #0 ;CLEAR INDICES
3300 LDY #0
3310 LUP INX  ;X COUNTS BYTES MATCHED
3320 CPX CKBYT ;"CHECKED ALL?
3330 BEQ PRNT ;YES.[153] 'EM
3340 INY  ;NO.INDEX [164] [130] BYTE
3350 LDA (STADD),Y ;[161] [130] FROM START
3360 CMP (CKADD),Y ;CHECK [129] EQUALITY
3370 BEQ LUP ;MATCHES.[161] A[168]HER
3380 JMP MA1 ;NO MATCH.MOVE UP A BYTE
3390 ;[172]HERE [139] ALL BYTES MATCH[172]
3400 PRNT LDA MTCHFLG ;"PRINTED THIS STADD?
3410 BEQ PRST ;NO, SO PRINT IT
3420 PRNT1 JSR WAIT ;CHECK FOR SPACE BAR
3430 LDA #32 ;INDENT 2 SPACES
3440 JSR CHROUT
3450 JSR CHROUT
3460 LDA #36 ;$
3470 JSR CHROUT
3480 LDY #0 ;SET UPTO GET 2 BYTES
3490 MR2 CPY #2
3500 BEQ MR1
3510 LDA CKADD,Y ;GET ADD. OF MATCHING BYTES
3520 STA HLDR,Y ;STORE FOR CONVERSION
3530 INY  ;GET 2ND BYTE
3540 BNE MR2 ;ALWAYS BRANCH
3550 MR1 JSR PRNTHX ;CONVERT AND PRINT ADD.
3560 JMP MA1 ;RESET CKADD AND LOOP AGAIN
3570 ;*PRINT START ADDRESS MATCHED*
3580 PRST LDA #$0D ;CR
3590 JSR CHROUT
3600 LDA #36 ;$
3610 JSR CHROUT
3620 LDY #0 ;SET TO GET 2 BYTES
3630 PR2 CPY #2
3640 BEQ PR1
3650 LDA STADD,Y ;GET 1ST BYTE
3660 STA HLDR,Y ;SAVE FOR CONVERSION
3670 INY  ;SET FOR NEXT BYTE
3680 BNE PR2
3690 PR1 JSR PRNTHX ;CONVERT AND PRINT
3700 LDA #1 ;SET FLAG TO SHOW
3710 STA MTCHFLG ;STADD WAS PRINTED
3720 JMP PRNT1 ;(null) PRINT CKADD
3730 ;*TEXT*
3740 TITLE .BYTE $20,$20,$20,$12
3750 .ASC "COMMON CODE" :.BYTE $92,$0D,$0D
3760 .ASC "START ADDRESS IN HEX ": .BYTE $0D,$00
3770 ERMESS .ASC "INPUT ERROR":.BYTE $0D,$00
3780 ENDMESS .ASC "END ADDRESS IN HEX ":.BYTE $0D,$00
3790 OUTMESS .ASC "OUTPUT TO ": .BYTE $12
3800 .ASC "S": .BYTE $92
3810 .ASC "CREEN OR ":.BYTE $12
3820 .ASC "P": .BYTE $92
3830 .ASC "RINTER" :.BYTE $0D,$00
3840 BYTMESS .ASC "BYTE LENGTH IN HEX":.BYTE $0D,$37,$9D,$00
3850 ;*SUBROUTINES*
3860 GET JSR CHRIN ;GET USER INPUT
3870 CMP #$0D ;"CR?
3880 BEQ D[145]E ;YES.EXIT ROUTINE
3890 STA HXADD,X ;S[164]RE [198]II CHAR.
3900 INX  ;RAISE IDEX [129] [130]
3910 BNE [161] ;[203] [161] IT
3920 D[145]E RTS
3930 ;[172]MAKE 1 BYTE [198]II IN A BINARY[172]
3940 MAKBI CMP #58 ;"=>9?
3950 BCS LET ;YES, ITS A LETTER
3960 SEC  ;NO SO SUBTRACT 48
3970 SBC #48 ;FOR EQUIV. NUMBER
3980 RTS  ;RETURN
3990 LET SEC  ;FOR A TO F
4000 SBC #55 ;SUBTRACT 55
4010 RTS
4020 ;*CHECK IF VALID HEX ASCII*
4030 EVAL CMP #71 ;"=>G?
4040 BCS BAD ;YES, NO [203]OD
4050 CMP #65 ;"ITS < G.IS IT =>A?
4060 BCS (null)OD ;YES, ITS VALID
4070 CMP #58 ;"ITS <A.IS IT =>:?
4080 BCS BAD ;YES.NO [203]OD
4090 CMP #48 ;"<:.IS IT <0?
4100 BCC BAD ;YES. NO (null)OD
4110 (null)OD CLC  ;RANGE OK.
4120 RTS  ;BACK TO CALLER
4130 BAD PLA  ;INVALID.PULL RETURN
4140 PLA  ;ADD. FROM STACK
4150 JMP ERROR ;USER RESTART
4160 ;*SET UP PRINTER FILE*
4170 PROUT LDA #7 ;FILE #
4180 LDX #4 ;DEVICE
4190 LDY #$FF ;BOGUS SECOND. ADD.
4200 JSR SETLFS ;DEFINE THE FILE
4210 LDA #00 ;NO NAME, NO LENGTH
4220 JSR SETNAM ;REQUIRED CALL
4230 JSR OPEN ;OPEN FILE 7
4240 LDX #7 ;SET FILE 7 FOR OUTPUT
4250 JSR CHKOUT
4260 RTS  ;BACK TO CALLER
4270 ;*CHECK/ACCEPT SPACE BAR PAUSE*
4280 WAIT LDA #0 ;CLEAR FLAG TO SHOW
4290 STA INFLG ;WE'RE NOT WAITING
4300 WA2 LDA $CB ;CURRENT KEY PRESSED
4310 CMP #64 ;64=NO KEY
4320 BEQ (null)ON ;NO KEY, NOTHING TO DO
4330 CMP #60 ;"SPACE BAR?
4340 BNE [203][145] ;NO, SO IGN[176]E
4350 LDA INFLG ;WAS SPACE BAR.
4360 BNE G1 ;[139] SET,[146] IS OVER
4370 WA1 LDA $CB ;START THE [146]
4380 CMP #64 ;[129] SPACE BAR RELEASE
4390 BNE WA1 ;KEEP [146]ING
4400 LDA #1 ;SET FLAG [164] SHOW
4410 STA INFLG ;WE'RE LOOKING [129] 2ND
4420 JMP WA2 ;HIT OF SPACE BAR
4430 [203][145] LDA INFLG ;[139] FLAG SET
4440 BNE WA2 ;KEEP LOOKING
4450 G1 RTS  ;THE [146]S OVER
4460 ;[172]START CURS[176] BLINK[172]
4470 CR[145] LDA #0 ;CLEAR THIS BYTE
4480 STA $CC ;[164] START BLINK
4490 RTS
4500 ;[172][144] CURS[176] BLINK[172]
4510 CROF LDA #1 ;SET BYTE [164]
4520 STA $CC ;[144] BLINK
4530 RTS
4540 ;[172]2 BYTE BINARY [164] 4 BYTE [198]II HEX[172]
4550 MAKHX LDX #1 ;X SET [164] [161] BYTE
4560 LDY #0 ;Y SET [164] [148] [198]II
4570 HX3 LDA HLDR,X ;[161] BYTE(HI FIRST)
4580 [175] #$F0 ;MASK LOW NYBBLE
4590 LSR  ;SH[139]T HI NYBBLE [164] LOW
4600 LSR
4610 LSR
4620 LSR
4630 HX1 CMP #10 ;"=>10?
4640 BCS ADMOR ;YES, MAKE LETTER
4650 CLC  ;NO.NUMBER
4660 ADC #48 ;ADD 48 FOR ASCII
4670 HX2 STA HXADD,Y ;STORE IT
4680 INY  ;RAISE COUNTER
4690 CPY #3 ;"DONE 3 NYBBLES?
4700 BEQ SKIP ;YES,DO 4TH
4710 BCS DUN ;Y[177]3.WE'RE D[145]E
4720 CPX #0 ;"Y<3.HIBYTE DONE?
4730 BEQ NXTBYT ;YES.DO LOW
4740 LDA HLDR,X ;NO.GET LO NYB,HI BYTE
4750 HX4 AND #$0F ;MASK HI NYBBLE
4760 DEX  ;LOWER COUNTER
4770 JMP HX1 ;MAKE ASCII
4780 ADMOR CLC  ;CONVERT BINARY LETTER
4790 ADC #55 ;TO ASCII BY
4800 JMP HX2 ;ADDING 55
4810 SKIP LDA HLDR,X ;GET LO BYTE LAST TIME
4820 JMP HX4 ;DO LO NYBBLE
4830 NXTBYT LDY #2 ;RESET INDICES FO
4840 LDX #0 ;2ND ADDRESS BYTE
4850 JMP HX3 ;LOOP AGAIN
4860 DUN RTS  ;RETURN
4870 ;*PRINT HEX ADD.STORED IN HXADD*
4880 PRNTHX JSR MAKHX ;BINARY TO HEX
4890 LDX #0 ;CLEAR INDEX
4900 LUPE CPX #4 ;DO 4 NUMBERS
4910 BEQ FIN
4920 LDA HXADD,X ;GET ASCII HEX
4930 JSR CHROUT ;PRINT IT
4940 INX  ;POINT TO NEXT CHAR.
4950 BNE LUPE ;ALWAYS BRANCH
4960 FIN LDA #$0D ;CR
4970 JSR CHROUT
4980 RTS  ;RETURN
4990 ;*PROGRAM FINISHED, CLEAN UP*
5000 EXIT JSR CLRCHN ;RESET DEFAULT DEVICES
5010 LDA #7 ;DEFAULT VALUE & FILE#
5020 STA CKBYT ;SAVE IT
5030 JSR CLOSE ;CLOSE FILE 7
5040 RTS  ;BACK TO BASIC
5050 ;*STORAGE*
5060 HXADD .BYTE 0,0,0,0 ;4 BYTES TO HOLD ASCII HEX
5070 MTCHCK .BYTE 0,0 ;LAST ADD. TO CHECK
5080 ENCK .BYTE 0,0 ;LAST ADD. FOR MATCH
5090 INFLG .BYTE 0 ;USER ADD. INPUT FLAG
5100 CKBYT .BYTE $07 ;# BYTES TO MATCH
5110 MTCHFLG .BYTE 0 ;NEW GROUP FLAG
5120 HLDR .BYTE 0,0 ;TEMPORARY STORAGE
5130 .END